#!/usr/bin/perl
# vim: ts=4

use warnings;
use strict;
use POE qw(Component::IRC Component::IRC::Plugin::Connector);
use DBI;
use Config::IniFiles;
use Digest::MD5 qw(md5_hex);
use Getopt::Long;
use Data::Dumper;

my @commandqueue		    = ();
my $nickresolvecache	    = {};
my $config_file			    = '../ubiquity.conf';
my $all_commands_regex      = '^!(g(?:oogle)?|learn|l|m(?:an)?(?: ?5[0156])?|n(?:oo)?(?: ?5[0156])?|t(?:ell)?|kb|kickban|8ball|ban|w|perror|h(?:elp)?|roll|wb|karma|version) ?(.*)$';
my $directed_commands_regex = '^(g(oogle)?|l|m( ?5[0156])?|n( ?5[0156])?|t(ell)?|kb|kickban|8ball|ban|wb)$';

my $result				= GetOptions (
	  'c:s'			=> \$config_file
	, 'config:s'	=> \$config_file
) or die( 'Invalid config option' );


# read configfile
my %cfg;
tie %cfg, 'Config::IniFiles', ( -file => $config_file );

# configuration options
sub CHANNEL () { "#" . $cfg{'irc'}{'channel'} }
my $refmanpath = 'http://dev.mysql.com/doc/refman/';
my $defaultversion = $cfg{'manual'}{'defaultversion'};
substr( $defaultversion, 1, 0, '.' );
my $refmanpathdefaultversion = $refmanpath . $defaultversion . '/en/';

my @dbcredentials = (
	'DBI:mysql:database=' . $cfg{'database'}{'schema'} . ';host=' .	$cfg{'database'}{'host'} ,
	$cfg{'database'}{'username'} ,
	$cfg{'database'}{'password'} , 
	{'RaiseError' => 1}
);


open LOG, '>>', $cfg{'log'}{'filename'} or die $!;
autoflush LOG 1;

# Create the component that will represent an IRC network.
my ($irc) = POE::Component::IRC->spawn();

# Create the bot session.  The new() call specifies the events the bot
# knows about and the functions that will handle those events.
POE::Session->create(
	inline_states => {
		_start		=> \&bot_start,
		irc_001		=> \&on_connect,
		irc_public	=> \&on_public,
		irc_msg		=> \&on_private,
		irc_whois	=> \&on_whois,
		lag_o_meter	=> \&lag_o_meter,
	},
);

# The bot session has started.  Register this bot with the "magnet"
# IRC component.  Select a nickname.  Connect to a server.
sub bot_start {

	my ($kernel, $heap) = @_[KERNEL, HEAP];

	$irc->yield( register => 'all' );

	#send a ping to the server if no activity seen in the channel for 180s.
	#in case of disconnect (or timeout detected), reconnect after 45s.
	$heap->{connector} = POE::Component::IRC::Plugin::Connector->new( 'delay' => 180, 'reconnect' => 45 );
	$irc->plugin_add( 'Connector' => $heap->{connector} );

	$irc->yield(
			connect => {
			Nick		=> $cfg{'irc'}{'nickname'} ,
			Username	=> $cfg{'irc'}{'nickname'} ,
			Ircname		=> 'utility bot for #mysql',
			Server		=> $cfg{'irc'}{'server'}   ,
			Port		=> $cfg{'irc'}{'port'}     ,
			LocalAddr	=> $cfg{'irc'}{'bindaddress'},
			}
		   );

	$kernel->delay( 'lag_o_meter' => 300 );
}

# The bot has successfully connected to a server.  Join a channel.
sub on_connect {
# identify with NickServ if a password is given
	if( ( defined( $cfg{'irc'}{'irc_password'} ) ) && ( $cfg{'irc'}{'irc_password'} ne '' ) ) {
#		sleep( 3 );
		$irc->yield( privmsg => 'NickServ', 'identify ' . $cfg{'irc'}{'irc_password'} );
	}
#sleep( 1 );
	$irc->yield( join => CHANNEL );
}

# yes, that is how the plugin author called it. not my idea.
# print "lag" as debug output to the LOG every 5 minutes.
sub lag_o_meter {
	my ($kernel,$heap) = @_[KERNEL,HEAP];
	print LOG "[" . (scalar localtime) . "] Lag: " . $heap->{connector}->lag() . "\n";
	$kernel->delay( 'lag_o_meter' => 300 );
}

# The bot has received a public message.  Parse it for commands, and
# respond to interesting things.
sub on_public {
	my ( $kernel, $who, $where, $msg ) = @_[KERNEL, ARG0, ARG1, ARG2];
	my $nick    = ( split /!/, $who )[0];
	my $channel = $where->[0];
	my $ts      = scalar localtime;
	my ($channel_nohash) = $channel =~ /^#(.+)$/;

	#if( my ($command, $arguments) = $msg =~ /^!([^ ]+) ?(.*)/ ) {
    if( my ($command, $arguments) = $msg =~ /^$all_commands_regex/ ) {

		print LOG "[$ts] <$nick:$channel> $msg\n";

		my $to_nick     = '';
		my $answer      = '';
		my $request     = '';
		my $tmpresult   = '';
        my $manversion  = '';
		my $dbh = DBI->connect( @dbcredentials );
		my ( $sth, $arr );

		my $ok=1;

		$arguments =~ s/^\s+//; #get rid of spaces at the front.
		$arguments =~ s/\s+$//; #get rid of spaces at the end.

#			if( $command eq 'tell' || $command eq 't' || $command eq 'm' || $command eq 'n' || $command eq 'g' || $command eq 'google' || $command eq 'l' || $command eq '8ball' || $command eq 'wb' ) {  
#			if ( exists { map { $_ => } @directed_commands }->{$command} ) { #next param is the destination nick
            if( $command =~ m/$directed_commands_regex/ ) { #next param is the destination nick
				if ( ( $to_nick, $arguments ) = $arguments =~ /^([^ ]+)(.*)/ ) { 
					$arguments =~ s/^\s+//; #get rid of spaces at the front.
					#a tiny feature I always missed with the_wench :)
					if( $to_nick eq 'me' ) {
						$to_nick = $nick;
					} elsif ( $to_nick eq 'us' ) {
						$to_nick = $channel;
					}
					$answer = $to_nick . ': ';
				} else {
					$to_nick = '';
					$answer = '';
				}
			}

		if( $command eq 'tell' || $command eq 't' ) { #factoid lookup
			my $about = '';
			if( (defined( $arguments )) && ( ( $about,$request ) = $arguments =~ /^(about)? *(.+)/ )) { #its ok to not write the about, users are lazy.
                $tmpresult = get_factoid( $channel_nohash, $request );
                if( $tmpresult ne '' ) {
					$answer .= $tmpresult;
                    $irc->yield( privmsg => CHANNEL, $answer );
                }
			}
		}

#		if( $command eq 'm' || $command eq 'man' ) { #return matching manual section
        if( (my $an, $manversion) = $command =~ /^m(an)? ?(5[0156])?$/ ) { #return matching manual section
            if( !defined($manversion) ) {
                $manversion = $cfg{'manual'}{'defaultversion'};
            }
			if( ($request) = $arguments =~ /^(.+)/ ) {
				$tmpresult = get_my_manual( $request, $manversion );
				if( $tmpresult ne '' ) {
					$answer .= 'See ' . $tmpresult;
				} else {
					$answer = $nick . ': Sorry, I have no idea about that manual entry.';
				}
				print LOG $answer . "\n";
				$irc->yield( privmsg => CHANNEL, $answer );
			}
		}

		if( $command eq 'wb' || $command eq 'wayback' ) { #return matching manual section, but for search in archive.org. Only for default manual version
			if( ($request) = $arguments =~ /^(.+)/ ) {
				$tmpresult = get_my_manual( $request, $cfg{'manual'}{'defaultversion'} );
				if( $tmpresult ne '' ) {
					$answer .= 'See http://wayback.archive.org/web/form-submit.jsp?url=' . $tmpresult;
				} else {
					$answer = $nick . ': Sorry, I have no idea about that manual entry.';
				}
				print LOG $answer . "\n";
				$irc->yield( privmsg => CHANNEL, $answer );
			}
		}

		#if( $command eq 'n' || $command eq 'noo' ) { #return matching manual section with #anchor to the function description
        if( (my $an, $manversion) = $command =~ /^n(oo)? ?(5[0156])?$/ ) { #return matching manual section with #anchor to the function description
            if( !defined($manversion) ) {
                $manversion = $cfg{'manual'}{'defaultversion'};
            }
			if( ($request) = $arguments =~ /^(.+)/ ) {
				$tmpresult = get_my_function( $request, $manversion );
				if( $tmpresult ne '' ) {
					$answer .= 'See ' . $tmpresult;
				} else {
					$answer = $nick . ': Sorry, I have no idea about that function.';
				}
				print LOG $answer . "\n";
				$irc->yield( privmsg => CHANNEL, $answer );
			}
		}

		if( $command eq 'g' || $command eq 'google' || $command eq 'l' ) { #the beloved feature of (let me) google this for you
			if( ($request) = $arguments =~ /^(.+)/ ) {
				$request = substr( $request, 0, 100 );
				$request =~ s/ /+/g;
				if( $command eq 'l' ) {
					$answer .= 'See http://lmgtfy.com/?q=' . $request;
				} else {
					$answer .= 'See http://google.com/search?btnG=1&q=' . $request;
				}
				print LOG $answer . "\n";
				$irc->yield( privmsg => CHANNEL, $answer );
			}
		}

		if( $command eq '8ball' ) {
			$sth = $dbh->prepare( "SELECT eightball_value FROM eightball ORDER BY RAND() LIMIT 1" );
			$sth->execute();
			if( $sth->rows > 0 ) {
				$arr = $sth->fetchrow_hashref();
				$sth->finish();
				$answer .= $arr->{'eightball_value'};
				print LOG $answer . "\n";
				$irc->yield( privmsg => CHANNEL, $answer );
			}
		}

		if( $command eq 'version' ) {
			if( ($request) = $arguments =~ /^([0-9a-zA-Z\.]{1,12})/ ) {
				$sth = $dbh->prepare( "SELECT release_info, release_url FROM my_version_release WHERE my_version_release = ?" );
				$sth->execute( $request );
				if( $sth->rows > 0 ) {
					my $row = $sth->fetchrow_hashref();
					$answer = $request . ': ' . $row->{'release_info'} . ' - for release notes see: http://' . $row->{'release_url'};
					print LOG $answer . "\n";
					$irc->yield( privmsg=> CHANNEL, $answer );
				}
				$sth->finish();
			}
		}

		if( $command eq 'perror' ) {

			if( ($request) = $arguments =~ /^([0-9]{1,7})\s*$/ ) {
				$sth = $dbh->prepare( "SELECT error_scope, error_message FROM perror WHERE error_id=? ORDER BY error_scope" );
				$sth->execute( $request );
				my $scopes = { 'O'=>'OS', 'M'=>'MySQL', 'N'=>'NDB' };
				if( $sth->rows > 0 ) {
					while( my $row = $sth->fetchrow_hashref() ) {
						$answer = $scopes->{ $row->{'error_scope'} } . ' error code ' . $request . ': ' . $row->{ 'error_message' };
						print LOG $answer . "\n";
						$irc->yield( privmsg=> CHANNEL, $answer );
					}
				} else {
					$answer = "No error matching '" . $request . "' found.";
					print LOG $answer . "\n";
					$irc->yield( privmsg=> CHANNEL, $answer );
				}
				$sth->finish();
			}
		}

		if( $command eq 'ban' ) {

		}

		if( $command eq 'roll' ) {
		
			my $n;
			my $s;
			if( $arguments =~ m/^[1-9][0-9]{0,6}$/ ) {
				$answer = $nick . ' rolls ' . (int(rand($arguments)) + 1);
				print LOG $answer . "\n";
				$irc->yield( privmsg => CHANNEL, $answer );
			}
			if( ($n,$s) = $arguments =~ m/^([0-9])d([1-9][0-9]?)$/ ) {
				$tmpresult = int(0);
				$answer = '( ';
				for( my $i = 1; $i <= $n; $i++ ) {
					my $cur = int(rand($s)) + 1;
					$tmpresult = $tmpresult + $cur;
					$answer .= $cur . ' ';
				}
				if( $n > 1 ) {
					$answer = $tmpresult . '  ' . $answer . ')';
				} else {
					$answer = $tmpresult;
				}
				$answer = $nick . ' rolls ' . $answer;
				$irc->yield( privmsg => CHANNEL, $answer );
			}
		}

		if( $command eq 'learn' ) {
			my $learntype = '';
			my $source = '';
			my $target = '';
			if( ($learntype, $source, $target) = $arguments =~ /^([^ ]+) +([^\:]+) ?\:\: ?(.*)$/ ) {
				if( $learntype eq 'factoid' || $learntype eq 'f' || $learntype eq 'trigger' || $learntype eq 't' || $learntype eq 'alias' || $learntype eq 'a' ) {
					if( defined( $nickresolvecache->{$nick} ) && ( time() - $nickresolvecache->{$nick}{'entrytime'} < 30 ) ) {
						print LOG "debug nickresolvecache worked for $nick";
						ubi_learn( { 'nick' => $nick, 'learntype' => $learntype, 'source' => $source, 'target' => $target, 'channel' => $channel_nohash } );
					} else {
						my @params = ( $nick, $learntype, $source, $target );
						push( @commandqueue, { 	'nick' => $nick, 
												'command' => 'ubi_learn',
												'params' => { 'nick' => $nick, 'learntype' => $learntype, 'source' => $source, 'target' => $target, 'channel' => $channel_nohash } } );
						$irc->yield( whois => $nick );
					}
				} else {
					$irc->yield( privmsg => CHANNEL, '!learn f[actoid]|t[rigger]|a[lias] <key text> :: <value text>' );
				}
			} else {
				$irc->yield( privmsg => CHANNEL, '!learn f[actoid]|t[rigger]|a[lias] <key text> :: <value text>' );
			}
		}

		if( $command =~ /^h(elp)?/ ) {
			my $tmp = '';
			my $help = '';
			my $answer = '';
			if( ($help) = $arguments =~ /^(.+)$/ ) {
				if ( $help eq 'm' ) {
					$answer = '!m[50|51|55|56] <nick> <section>  ### Tells <nick> the URL to the section in the MySQL manual on dev.mysql.com. I.e. !m johndoe select ### Will also search for functions and settings, but with a lower priority than sections. ### Use two digits to optionally indicate the server version.';
				} elsif ( $help eq 'man' ) {
					$answer = '!man[50|51|55|56] <section>  ### Return the URL to the section in the MySQL manual on dev.mysql.com. I.e. !man select ### Will also search for functions and settings, but with a lower priority than sections. ### Use two digits to optionally indicate the server version.';
				} elsif ( $help eq 'n' ) {
					$answer = '!n[50|51|55|56] <nick> <function>  ### Tells <nick> the URL to page anchor in the MySQL manual where the mysql <anchor> is described. I.e. !n johndoe date_format, !n johndoe innodb_log_file_size. ### Use two digits to optionally indicate the server version.';
				} elsif ( $help eq 'noo' ) {
					$answer = '!noo[50|51|55|56] <anchor>  ### Return the URL to the page anchor in the MySQL manual where the mysql <anchor> is described. I.e. !noo date_format, or !noo innodb_log_file_size. ### Use two digits to optionally indicate the server version.';
				} elsif ( $help =~ /^t(ell)?$/ ) {
					$answer = '!t[ell] <nick>|me|us [about] <factoid>  ### Looks up the <factoid> in an internal database and returns it to the channel, prepended with the given nick. "about" may be left out. I.e. !t me about reset root  (Also see "!learn" and "!t me db")';
				} elsif ( $help =~ /^g(oogle)?$/ ) {
					$answer = '!g[oogle] <nick> <search>  ### Returns a URL to a Google result based on <search> string. Use it to diplomatic tell a user that Google might be the best choice for his question.';
				} elsif ( $help eq 'l' ) {
					$answer = '!l <nick> <search>  ### Returns a URL to lmgtfy.com containing <search> string. Use it to not-so-diplomatic tell a user that his questions can be easily answered by using Google';
				} elsif ( $help eq 'perror' ) {
					$answer = '!perror <errorid>  ### Returns the corresponding error message to the given <errorid>, either system error or mysql error. Example: !perror 13  ### Note: that command comes with mysql, so you can run "perror 13" on your shell as well.';
				} elsif ( $help =~ /^learn/ ) {
					$answer = "!learn f[actoid]|t[rigger]|a[lias] <key> :: <value>  ### Teach the bot a new factoid, trigger or alias - but don't add garbage! You need to be identified with NickServ for !learn. An alias can only be created to an existing factoid. To teach a new factoid <key>, that <key> must not exist. Triggers are special factoids the bot will return even without !tell. Note the delimiter :: between key and value.";
				} elsif ( $help =~ /^roll/ ) {
					$answer = "!roll <s>|<n>d<s>  ### Let the bot roll one or more dice for you. <n> number of dice, <s> number of sides. if you only specify <s>, one die will be rolled.  Example: !roll 20  will roll one die with 20 sides.";
				} else {
					$answer = 'Sorry, that is an unknow help topic';
				}
			} else {
				$answer = '!m[<version>] <nick> <section>  !man[version] <section>  !n[version] <nick> <function>  !noo[version] <function>  !t[ell] <nick>|me|us [about] <factoid>  !g[oogle] <nick> <search>  !l <nick> <search>  !perror <errorid>  !learn f[actoid]|t[rigger]|a[lias] <key> :: <value>  !8ball [nick]  !roll <s>|<n>d<s>  !h[elp] [<command>]';
			}
			print LOG $answer . "\n";
			$irc->yield( privmsg => CHANNEL, $answer );
		}

        if( $command eq 'karma' ) {
            my $answer = '';
            if( my ($target) = $arguments =~ /^(.+) *$/ ) {
				$sth = $dbh->prepare( 'SELECT karma_value FROM karma K JOIN channel C ON K.channel_id=C.channel_id '
						. ' WHERE C.channel_name = ' . $dbh->quote( $channel_nohash )
						. ' AND K.karma_target = ' . $dbh->quote( $target ) );
				$sth->execute();
				if( $sth->rows > 0 ) {
					my $arr = $sth->fetchrow_hashref();
					$answer = $arr->{'karma_value'};
				} else {
					$answer = 0;
				}
				$sth->finish();
				$irc->yield( privmsg => CHANNEL, $target . ': ' . $answer );
			}
		}

		$dbh->disconnect();

	} # !command parsing
	#karma handling
	elsif ( my ($target, $plusminus) = $msg =~ /^([^ \+]{2,20})(\+\+|--) *$/ ) {
		my $value = 1;
		if( $plusminus eq '--' ) {
			$value = -1;
		}
		if( $target eq $nick ) {
			$value = -1;
			$irc->yield( privmsg => CHANNEL, $nick.'--' );
		}
		if( ( $value == 1 ) && ( $target eq $cfg{'irc'}{'nickname'} ) ) {
			$irc->yield( ctcp => CHANNEL, 'ACTION blushes.' );
		}
		my $dbh = DBI->connect( @dbcredentials );
		my $sth = $dbh->prepare( 'SELECT channel_id FROM channel WHERE channel_name = ' . $dbh->quote( $channel_nohash ) );
		$sth->execute();
		if( $sth->rows > 0 ) {
			my $arr = $sth->fetchrow_hashref();
			my $channel_id = $arr->{'channel_id'};
			$dbh->do( 'INSERT INTO karma (channel_id, karma_target, karma_value, date_created ) VALUES ( '
					. $channel_id . ', '
					. $dbh->quote( $target ) . ', '
					. $value . ', '
					. 'NOW() ) ON DUPLICATE KEY UPDATE karma_value = karma_value+ '
					. $value );
		}
		$sth->finish();
		$dbh->disconnect();
	}
	#no command, no karma, so look for triggers
	elsif ( length($msg) <= 30 ) { #fact_key is max 30 chars, so every message larger than that is no trigger.
		my $search = $msg;
		$search =~ s/^\s+//;
		$search =~ s/\s+$//;
		my $answer = '';
		my $dbh = DBI->connect( @dbcredentials );
		my $sth = $dbh->prepare( 'SELECT fact_value FROM factoid F JOIN channel C ON F.channel_id=C.channel_id
									WHERE C.channel_name = ' . $dbh->quote( $channel_nohash )
									. ' AND entry_type = "T" AND is_visible = 1 '
									. ' AND fact_key = ' . $dbh->quote($msg) );
		$sth->execute();
		if( $sth->rows > 0 ) {
			my $arr = $sth->fetchrow_hashref();
			$answer = $arr->{'fact_value'};
			$answer =~ s/<1>/$refmanpathdefaultversion/; #some factoids have <1> tags, to be replaced by the path to the refman URL
            $answer =~ s/<nick>/$nick/; #replace <nick>
			print LOG "[" . (scalar localtime) . "] *trigger* on $msg : $answer \n";
			$irc->yield( privmsg => CHANNEL, $answer );
		}
        $sth->finish();
		$dbh->disconnect();
	}
}

sub on_private {
	my ( $kernel, $who, $receiver, $msg ) = @_[KERNEL, ARG0, ARG1, ARG2];
	my $nick    = ( split /!/, $who )[0];
	my $ts      = scalar localtime;
	#definitions needed to make the !t !tell command work ok as priv msg
	my $request = '';
	my $tmpresult = '';
	my $answer = '';
    my $manversion = '';
#my $to_nick = '';
	my $channel = '#mysql';
	my ($channel_nohash) = $channel =~ /^#(.+)$/;
		my $dbh = DBI->connect( @dbcredentials );
		my ( $sth, $arr );
	# surpress passwords in the logfile
	if( $msg =~ /^!newpass / ) {
		print LOG "[$ts] *$nick* !newpass (password not shown here...)\n";
	} else {
		print LOG "[$ts] *$nick* $msg\n";
	}
    my $priv_commands_regex      = '^!(help|newpass|m(?:an)?(?: ?5[0156])?|n(?:oo)?(?: ?5[0156])?|t(?:ell)?) ?(.*)$';
	#if( my ($command, $arguments) = $msg =~ /^!([^ ]+) ?(.*)/ ) {
    if( my ($command, $arguments) = $msg =~ /$priv_commands_regex/ ) {

		if( $command eq 'tell' || $command eq 't' ) { #factoid lookup
			my $about = '';
			my  $me = '';
			if( (defined( $arguments )) && ( ( $me, $about,$request ) = $arguments =~ /^(me)? *(about)? *(.+)/ )) { #its ok to not write the about, users are lazy. And for the priv msg its also ok to omit the "me"
				my $answer = get_factoid( $channel_nohash, $request );
				if( $answer ne '' ) {
					print LOG $answer . "\n";
					$irc->yield( privmsg => $nick, $answer );
				}
			}
		}

#		if( $command eq 'm' || $command eq 'man' ) { #return matching manual section
        if( (my $an, $manversion) = $command =~ /^m(an)? ?(5[0156])?$/ ) { #return matching manual section
            if( !defined($manversion) ) {
                $manversion = $cfg{'manual'}{'defaultversion'};
            }        
			if( ($request) = $arguments =~ /^(.+)/ ) {
				$answer = get_my_manual( $request, $manversion );
				if( $answer ne '' ) {
					print LOG $answer . "\n";
					$irc->yield( privmsg => $nick, $answer );
				} else {
					$irc->yield( privmsg => $nick, 'Sorry, I have no idea about that manual entry.' );
				}
			}
		}

#		if( $command eq 'n' || $command eq 'noo' ) { #return matching manual section with #anchor to the function description
        if( (my $an, $manversion) = $command =~ /^n(oo)? ?(5[0156])?$/ ) { #return matching manual section with #anchor to the function description
            if( !defined($manversion) ) {
                $manversion = $cfg{'manual'}{'defaultversion'};
            }           
			if( ($request) = $arguments =~ /^(.+)/ ) {
				$tmpresult = get_my_function( $request, $manversion );
				if( $tmpresult ne '' ) {
					$answer = 'See ' . $tmpresult ;
				} else {
					$answer = 'Sorry, I have no idea about that function.';
				}
				print LOG $answer . "\n";
				$irc->yield( privmsg => $nick, $answer );
			}
		}

		if( $command eq 'newpass' ) {
			if( (defined( $arguments )) && ( ( my $newpass ) = $arguments =~ /^(.+)$/ ) ) {
				$newpass =~ s/^\s+//;
				$newpass =~ s/\s+$//;
				if( length($newpass) < 5 ) {
					$irc->yield( privmsg => $nick, 'Come on, you should be able to memorize a password with at least 5 digits...' );
				} else {

					if( defined( $nickresolvecache->{$nick} ) && ( time() - $nickresolvecache->{$nick}{'entrytime'} < 30 ) ) {
                        print LOG "debug nickresolvecache worked for $nick";
                        ubi_newpass( { 'nick' => $nick, 'newpass' => $newpass } );
                    } else {
						my @params = ( $nick, $newpass );
						push( @commandqueue, {  'nick' => $nick,
												'command' => 'ubi_newpass',
												'params' => { 'nick' => $nick, 'newpass' => $newpass } } );
						$irc->yield( whois => $nick );
                    }
				}
			} else {
				$irc->yield( privmsg => $nick, '!newpass <yournewpass>  - Will create or update your password for the ubiquiry web interface. Your password has to be >=5 characters, no spaces. I suggest to not use your NickServ password here.' );
			}
		}

		if( $command eq 'help' ) {
			my $tmp = '';
			my $help = '';
			my $answer = '';
			if( ($help) = $arguments =~ /^(.+)$/ ) {
				if ( $help =~ /^m(an)?$/ ) {
					$answer = '!m[an][50|51|55|56] <section>  # Tells you the URL to the section in the MySQL manual on dev.mysql.com. I.e. !m select  Will also search for functions and settings, but with a lower priority than sections. Use two digits to optionally indicate the server version.';
				} elsif ( $help =~ /^n(oo)?$/ ) {
					$answer = '!n[oo][50|51|55|56] <function>  # Tells you the URL to page anchor in the MySQL manual where the mysql <anchor> is described. I.e. !n date_format, !n innodb_log_file_size . Use two digits to optionally indicate the server version.';
				} elsif ( $help =~ /^t(ell)?$/ ) {
					$answer = '!t[ell] [me] [about] <factoid>  ### Looks up the <factoid> in an internal database and returns it to you. "me" and "about" may be left out in private mode. I.e. !t me about reset root  (Also see "!t me db")';
				} elsif ( $help eq 'newpass' ) {
					$answer = '!newpass <yournewpass>  - Will create or update your password for the ubiquiry web interface. Your password has to be >=5 characters, no spaces. I suggest to not use your NickServ password here.';
				} else {
					$answer = 'Sorry, that is an unknow help topic.';
				}
			} else {
				$answer = 'Available commands for /msg\'ing me: !m[an][50|51|55|56] <section>  !n[oo][50|51|55|56] <function>  !t[ell] [me] [about] <factoid>  !newpass <yournewpass>  !h[elp] [<command>]';
			}
			$irc->yield( privmsg => $nick, $answer );
		}
 
	} else {
        $irc->yield( privmsg => $nick, 'Hi, I\'m a bot :) You can use me on the public channel, or via /msg. Send !help, either to the channel to see the public commands - or as /msg to me to see the commands for the private mode. Btw, please don\'t /msg people without permission.' );
	}

}

sub get_factoid {
	my $channel  = $_[0];
	my $fact_key = $_[1];

	my $tmpresult = '';
	my $dbh = DBI->connect( @dbcredentials );

	my $qry = '
SELECT
      fact_value
FROM
    factoid
    JOIN channel    USING ( channel_id  )
    LEFT JOIN alias USING ( factoid_id  )
WHERE
        channel_name = ?
    AND ? IN ( fact_key, alias )
';
	$qry =~ s/\n/ /g;
	$qry =~ s/\s{2,}/ /g;
	my $sth = $dbh->prepare( $qry );

	$sth->execute( $channel, $fact_key );
	if( $sth->rows > 0 ) {
		my $arr = $sth->fetchrow_hashref();
		$tmpresult = $arr->{'fact_value'};
		$tmpresult =~ s/<1>/$refmanpathdefaultversion/g; #some factoids have <1> tags, to be replaced by the path to the refman URL
	}
	$sth->finish();
	$dbh->disconnect();
	return $tmpresult;
}

sub get_my_manual {
	my $request = $_[0];
    my $version = $_[1];

	my $tmpresult = '';
	my $dbh = DBI->connect( @dbcredentials );
	my $qry = '
SELECT
	section_name, anchor_name, 0 manual_type
FROM
	my_manual_versioned
WHERE
	manual_type=1 AND section_name LIKE ? AND version = ?
UNION
SELECT
	section_name, anchor_name, manual_type
FROM
	my_manual_versioned
WHERE
	manual_cleartext LIKE ? AND version = ?
ORDER BY
	manual_type, section_name, anchor_name
LIMIT 1
';
	$qry =~ s/\n/ /g;
	$qry =~ s/\s{2,}/ /g;
	my $sth = $dbh->prepare( $qry );

	$sth->execute( $request.'%', $version, $request.'%', $version );
	if( $sth->rows > 0 ) {
		my $arr = $sth->fetchrow_hashref();
		$tmpresult = $arr->{'section_name'};
		$tmpresult =~ s/ /-/g; #to allow searching, the section name has spaces in it, but the URL contains - instead of spaces.
        substr( $version, 1, 0, '.' );
		$tmpresult = $refmanpath . $version . '/en/' . $tmpresult . '.html'; # add URL prefix, version and .html suffix
		if( $arr->{'manual_type'} > 1 ) { #it was an anchor
			$tmpresult .= $arr->{'anchor_name'};
		}
	}
	$sth->finish();
	$dbh->disconnect();
	return $tmpresult;
}

sub get_my_function {
	my $request = $_[0];
    my $version = $_[1];    
	my $tmpresult = '';
	my $dbh = DBI->connect( @dbcredentials );

#in case we have multiple hits (ie !noo date), return the first one in order, not random
    my $qry = '
SELECT
    section_name, anchor_name
FROM
    my_manual_versioned
WHERE
    manual_type=2 AND manual_cleartext LIKE ? AND version = ?
ORDER BY
    manual_cleartext
LIMIT 1
';
	$qry =~ s/\n/ /g;
	$qry =~ s/\s{2,}/ /g;
	my $sth = $dbh->prepare( $qry );

	$sth->execute( $request.'%', $version );
	if( $sth->rows > 0 ) {
		my $arr = $sth->fetchrow_hashref();
		$tmpresult = $arr->{'section_name'};
		$tmpresult =~ s/ /-/g;
        substr( $version, 1, 0, '.' );
		$tmpresult = $refmanpath . $version . '/en/' . $tmpresult . '.html' . $arr->{'anchor_name'};
	}
	$sth->finish();
	$dbh->disconnect();
	return $tmpresult;
}

sub on_whois {
        my ( $kernel, $answer ) = @_[KERNEL, ARG0];
        my $nick = $answer->{'nick'};
        my $user = $answer->{'user'};
		my $account = '';
		if( defined( $answer->{'identified'} ) ) {
			$account = $answer->{'identified'};
		}

		$nickresolvecache->{$nick}{'user'} 		= $user;
		$nickresolvecache->{$nick}{'entrytime'}	= time();
		$nickresolvecache->{$nick}{'account'} 	= $account;
		my @newqueue = ();		

		my $queuelength = scalar(@commandqueue);
		for( my $i=0; $i < $queuelength; $i++ ) {
			if( $commandqueue[$i]->{'nick'} eq $nick ) {
				my $command = $commandqueue[$i]->{'command'};
				print LOG "on_whois found $nick with $command \n";
				no strict "refs";
				&$command( $commandqueue[$i]->{'params'} );
			} else {
				push( @newqueue, $commandqueue[$i] );
			}
		}
		@commandqueue = @newqueue;
}

sub ubi_newpass {
	my $params = shift;
	my $nick = $params->{'nick'};
	my $user = $nickresolvecache->{$nick}{'user'};
	my $account = $nickresolvecache->{$nick}{'account'}; #Will be '' if user is not identified with NickServ, see on_whois
	my $useridentifier = $user;
	my $newpass = $params->{'newpass'};

	if( ( defined( $cfg{'userauth'}{'identifier'} ) ) && ( $cfg{'userauth'}{'identifier'} eq 'account' ) ) {
		$useridentifier = $account;
	}

	print LOG "debug $nick with identifier $useridentifier wants to !newpass\n";
	if( $useridentifier eq '' ) {
		print LOG "debug no user identifier found. will not !newpass the user\n";
		$irc->yield( privmsg => $nick, "Sorry, I can't identify you. You can't change your password at the moment." );
		return;
	}

	my $dbh = DBI->connect( @dbcredentials );
	$dbh->begin_work();

	my $md5 = md5_hex( $useridentifier . $newpass );

	if ( !( $dbh->do( 'INSERT INTO bot_user (username, passwd, date_created) VALUES (' 
				. $dbh->quote( $useridentifier ) . ','
				. $dbh->quote( $md5 ) . ','
				. 'NOW() ) ON DUPLICATE KEY UPDATE passwd=' . $dbh->quote( $md5 ) )
	) ) {
		print LOG "error: " . $dbh->errstr;
		$irc->yield( privmsg => $nick, "Sorry, I encountered an internal error. Please notify an admin." );
	} else {
		$dbh->commit();
		$irc->yield( privmsg => $nick, "The password for you account " . $useridentifier . " has been successfully set. You can soon login on the web interface with it." );
	}
	$dbh->disconnect();
}

sub ubi_learn {
	my $params = shift;
	my $nick = $params->{'nick'};
	my $learntype = $params->{'learntype'};
	my $source = $params->{'source'};
	my $target = $params->{'target'};
	my $channel = $params->{'channel'};
	my $user = $nickresolvecache->{$nick}{'user'};
	my $account = $nickresolvecache->{$nick}{'account'};
	my $useridentifier = $user;

	if( ( defined( $cfg{'userauth'}{'identifier'} ) ) && ( $cfg{'userauth'}{'identifier'} eq 'account' ) ) {
		$useridentifier = $account;
	}

	print LOG "debug $nick with identifier $useridentifier wants to !$learntype '$source' '$target' \n";

	if( $useridentifier eq '' ) {
		print LOG "debug no user identifier found. will not learn \n";
		$irc->yield( privmsg => CHANNEL, $nick . ": Sorry, I can't identify you. You may not teach me at the moment." );
		return;
	}

	my $dbh = DBI->connect( @dbcredentials );
	$dbh->begin_work();	

	$source =~ s/\s+$//;

	my $botuserid = 0;
	my $sth = $dbh->prepare( 'SELECT bot_user_id FROM bot_user WHERE username = ' . $dbh->quote( $useridentifier ) . ' FOR UPDATE' );
	my $arr;
	$sth->execute();
	if( $sth->rows > 0 ) {
		$arr = $sth->fetchrow_hashref();
		$botuserid = $arr->{'bot_user_id'};
		print LOG "debug old bot_user_id is $botuserid \n";
	} else {
		$dbh->do( 'INSERT INTO bot_user (username, date_created) VALUES ( ' . $dbh->quote( $useridentifier ) . ', NOW() )' );
		$botuserid = $dbh->{mysql_insertid};
		print LOG "debug new bot_user_id is $botuserid \n";
	}

	# I assume somebody will manually enter the new channel with its ID into table channel when ubiquity will be used
    # for more than the one channel. I will not create a new channel entry here...
	my $channelid = 0;
	$sth = $dbh->prepare( 'SELECT channel_id FROM channel WHERE channel_name = ' . $dbh->quote( $channel ) . ' FOR UPDATE' );
	$sth->execute();
	if( $sth->rows > 0 ) {
		$arr = $sth->fetchrow_hashref();
		$channelid = $arr->{'channel_id'};
		print LOG "debug found channel_id for $channel : $channelid \n";
	} else {
		print LOG "ERROR during ubi_learn: $channel in table channel not found. \n";
		return;
	}

	if( $learntype eq 'factoid' || $learntype eq 'f' || $learntype eq 'trigger' || $learntype eq 't' ) {
		$sth = $dbh->prepare( 'SELECT 1 FROM factoid WHERE channel_id = ' . $channelid . ' AND fact_key = ' . $dbh->quote( $source ) . ' FOR UPDATE' );
		$sth->execute();
		if( $sth->rows > 0 ) {
			$dbh->rollback();
			$irc->yield( privmsg => CHANNEL, $nick . ': Sorry, that entry already exists' );
		} else {
			my $entrytype = 'F';
			if( $learntype eq 'trigger' || $learntype eq 't' ) {
				$entrytype = 'T';
			}
			if( $dbh->do( 'INSERT INTO factoid (fact_key, fact_value, creator_user_id, editor_user_id, entry_type, date_created, channel_id) VALUES ( '
						. $dbh->quote( $source ) . ', '
						. $dbh->quote( $target ) . ', '
						. $botuserid . ', '
						. $botuserid . ', '
						. $dbh->quote( $entrytype ) . ', '
						. 'NOW(), '
						. $channelid . ' )' ) ) {
				$dbh->commit();
				$irc->yield( privmsg => CHANNEL, "I have learned '$source' is '$target', as a " . ( ($learntype eq 'trigger' || $learntype eq 't') ? 'trigger' : 'factoid' ) );
			}
		}
	} elsif ( $learntype eq 'alias' || $learntype eq 'a' ) {
		my $factoidid = 0;
		$sth = $dbh->prepare( 'SELECT factoid_id FROM factoid WHERE channel_id = ' . $channelid . ' AND fact_key = ' . $dbh->quote( $target ) );
		$sth->execute();
		if( $sth->rows < 1 ) {
			$dbh->rollback();
			$irc->yield( privmsg => CHANNEL, $nick . ": Sorry, but no factoid about '$target' exists." );
		} else {
			$arr = $sth->fetchrow_hashref();
			$factoidid = $arr->{'factoid_id'};
			$sth = $dbh->prepare( 'SELECT 1 FROM alias WHERE channel_id = ' . $channelid . ' AND alias = ' . $dbh->quote( $source ) );
			$sth->execute();
			if( $sth->rows > 0 ) {
				$dbh->rollback();
				$irc->yield( privmsg => CHANNEL, $nick . ': Sorry, that entry already exists' );
			} else {
				if( $dbh->do( 'INSERT INTO alias (bot_user_id, alias, factoid_id, date_created, channel_id) VALUES ( '
								. $botuserid . ', '
								. $dbh->quote( $source ) . ', '
								. $factoidid . ', '
								. 'NOW(), '
								. $channelid . ')' )) {
					$dbh->commit();
					$irc->yield( privmsg => CHANNEL, "I have created an alias '$source' for '$target'." );
				}
			}
		}
	}

	$sth->finish();
	$dbh->disconnect();

}

# Run the bot until it is done.
$poe_kernel->run();
exit 0;

